/**
ECL interface module.

Authors: Kalman Kiss, kiskami@freemail.hu

Bugs:

Date: 

License: GNU General Public License

YASTACS game
Copyright (C) 2012 Kalman Kiss, kiskami@freemail.hu

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

Contact author at: kiskami@freemail.hu or
Hungary, 8900 Zalaegerszeg
Kakukkfu u 4.
*/
module scripting.ECL;

/*
windows (vc) lib conversion to a dmd linkable one:
1. def file generation, from windows lib: coffimplib.exe -e ecl.lib
2. edit def file for the missing symbols, for ex: _SDL_Init = SDL_Init ==> _SDL_Init@4 = SDL_Init
3. update lib: implib.exe SDL.lib SDL.def
*/

alias int cl_fixnum;
alias uint cl_index;
alias uint cl_hashkey;

alias void * cl_env_ptr;

/*
Character and string types in Unicode enabled ECL
Type			Without Unicode		With Unicode
standard-char	#\Newline,32-126	#\Newline,32-126
base-char		0-255				0-255
extended-char	-					255-16777215

ecl_base_char	- unsigned char
ecl_character	- unicode character

string			- (array character (*))
simple-string	- (simple-array character (*))	
*/
alias int ecl_character; // Unicode char!
alias ubyte ecl_base_char;

alias ubyte int8_t;

struct ecl_string {		/*  string header  */
	/*  adjustable flag  */
	/*  has-fill-pointer flag  */
	int8_t t, m, elttype, flags;	/*  array element type, has fill ptr, adjustable-p */
	cl_object displaced;	/*  displaced  */
	cl_index dim;       	/*  dimension  */
	/*  string length  */
	cl_index fillp;		/*  fill pointer  */
	/*  For simple strings,  */
	/*  st_fillp is equal to st_dim-1.  */
	ecl_character *self;	/*  pointer to the string  */
};

struct ecl_base_string {	/*  string header  */
	/*  adjustable flag  */
	/*  has-fill-pointer flag  */
	int8_t t, m, elttype, flags;	/*  array element type, has fill ptr, adjustable-p */
	cl_object displaced;	/*  displaced  */
	cl_index dim;       	/*  dimension  */
	/*  string length  */
	cl_index fillp;		/*  fill pointer  */
	/*  For simple strings,  */
	/*  st_fillp is equal to st_dim-1.  */
	ecl_base_char *self;	/*  pointer to the string  */
};


union cl_lispunion {
	ecl_string		ustring;
	ecl_base_string bstring;
};

alias cl_lispunion *cl_object;

alias cl_object cl_return;
alias cl_fixnum cl_narg;

alias void * cl_objectfn_fixed;

immutable cl_fixnum ECL_NIL = 1;

enum ecl_option {
	ECL_OPT_INCREMENTAL_GC = 0,
	ECL_OPT_TRAP_SIGSEGV,
	ECL_OPT_TRAP_SIGFPE,
	ECL_OPT_TRAP_SIGINT,
	ECL_OPT_TRAP_SIGILL,
	ECL_OPT_TRAP_SIGBUS,
	ECL_OPT_TRAP_SIGPIPE,
	ECL_OPT_TRAP_SIGCHLD,
	ECL_OPT_TRAP_INTERRUPT_SIGNAL,
	ECL_OPT_SIGNAL_HANDLING_THREAD,
	ECL_OPT_SIGNAL_QUEUE_SIZE,
	ECL_OPT_BOOTED,
	ECL_OPT_BIND_STACK_SIZE,
	ECL_OPT_BIND_STACK_SAFETY_AREA,
	ECL_OPT_FRAME_STACK_SIZE,
	ECL_OPT_FRAME_STACK_SAFETY_AREA,
	ECL_OPT_LISP_STACK_SIZE,
	ECL_OPT_LISP_STACK_SAFETY_AREA,
	ECL_OPT_C_STACK_SIZE,
	ECL_OPT_C_STACK_SAFETY_AREA,
	ECL_OPT_SIGALTSTACK_SIZE,
	ECL_OPT_HEAP_SIZE,
	ECL_OPT_HEAP_SAFETY_AREA,
	ECL_OPT_THREAD_INTERRUPT_SIGNAL,
	ECL_OPT_SET_GMP_MEMORY_FUNCTIONS,
	ECL_OPT_USE_SETMODE_ON_FILES,
	ECL_OPT_LIMIT
};

enum cl_elttype {			/*  array element type  */
	ecl_aet_object,		/*  t                */
	ecl_aet_sf,			/*  single-float     */
	ecl_aet_df,			/*  double-float     */
	ecl_aet_bit,		/*  bit              */
	ecl_aet_fix,		/*  cl_fixnum        */
	ecl_aet_index,		/*  cl_index         */
	/* Below here, list types accepted by streams (i.e. OPEN) */
	ecl_aet_b8,			/*  byte8	     */
	ecl_aet_i8,			/*  integer8	     */
	ecl_aet_b16, ecl_aet_i16,
	ecl_aet_b32, ecl_aet_i32,
	ecl_aet_b64, ecl_aet_i64,
	ecl_aet_ch,			/*  character        */
	ecl_aet_bc,			/*  base-char        */
	ecl_aet_last_type = ecl_aet_bc
} ;

extern (C) {

	void ecl_set_option( int option, cl_fixnum value); 
	int cl_boot( int argc, char **argv); 
	cl_fixnum ecl_get_option( int option); 
	int cl_shutdown();

	cl_env_ptr ecl_process_env();

	cl_object cl_eval(cl_object form);

//	ecl_character ecl_char( cl_object string_, cl_index ndx);

//	cl_object ecl_char_code( ecl_character code);
//	ecl_base_char ecl_base_char_code( cl_object o);

	cl_object ecl_alloc_adjustable_base_string( cl_index length);
	cl_object ecl_alloc_adjustable_simple_string( cl_index length);
	cl_object ecl_make_simple_base_string( ecl_base_char* data, cl_index length);
	cl_object ecl_make_constant_base_string( ecl_base_char* data, cl_index length);

	cl_object ecl_read_from_cstring(char *s);
	cl_object si_string_to_object (cl_narg narg, cl_object str, ...);
	char *ecl_base_string_pointer_safe(cl_object f);

	cl_object ecl_alloc_simple_vector(cl_index l, cl_elttype aet);
	cl_object ecl_alloc_adjustable_extended_string(cl_index l);
	cl_object ecl_alloc_simple_extended_string(cl_index l);

	ecl_character ecl_char_set( cl_object _string, cl_index ndx, ecl_character c);
	ecl_character ecl_char( cl_object string, cl_index ndx); 

	cl_object si_coerce_to_extended_string(cl_object x);

	cl_object ecl_aset1( cl_object vector, cl_index row_major_index, cl_object new_value); 

	void ecl_def_c_function(cl_object sym, cl_objectfn_fixed c_function, int narg);

	cl_object cl_identity(cl_object x);
	cl_object cl_null(cl_object x);
	alias cl_null cl_not;
	cl_object cl_symbolp(cl_object x);
	cl_object cl_atom(cl_object x);
	cl_object cl_consp(cl_object x);
	cl_object cl_listp(cl_object x);
	cl_object cl_numberp(cl_object x);
	cl_object cl_integerp(cl_object x);
	cl_object cl_rationalp(cl_object x);
	cl_object cl_floatp(cl_object x);
	cl_object cl_realp(cl_object x);
	cl_object cl_complexp(cl_object x);
	cl_object cl_characterp(cl_object x);
	cl_object cl_stringp(cl_object x);
	cl_object cl_bit_vector_p(cl_object x);
	cl_object cl_vectorp(cl_object x);
	cl_object cl_simple_string_p(cl_object x);
	cl_object cl_simple_bit_vector_p(cl_object x);
	cl_object cl_simple_vector_p(cl_object x);
	cl_object cl_arrayp(cl_object x);
	cl_object cl_packagep(cl_object x);
	cl_object cl_functionp(cl_object x);
	cl_object cl_compiled_function_p(cl_object x);
	cl_object cl_eq(cl_object x, cl_object y);
	cl_object cl_eql(cl_object x, cl_object y);
	cl_object cl_equal(cl_object x, cl_object y);
	cl_object cl_equalp(cl_object x, cl_object y);
	cl_object si_fixnump(cl_object x);

	bool floatp(cl_object x);
	bool ecl_numberp(cl_object x);
	bool ecl_realp(cl_object x);
	bool ecl_eql(cl_object x, cl_object y);
	bool ecl_equal(cl_object x, cl_object y);
	bool ecl_equalp(cl_object x, cl_object y);
	bool ecl_stringp(cl_object x);
	cl_object si_base_string_p(cl_object x);

};

// ====================================================

import std.string, std.c.string, std.utf, std.conv;
debug import std.stdio;

debug void displayExtStrInfo(cl_object s) {
	auto x = s.ustring;
	writeln("Unicode string, t=", x.t, ", m=", x.m, ", elttype=", x.elttype, ", flags=", x.flags
			, ", dim=", x.dim, ", fillp=", x.fillp, ", *self=", x.self);
}

bool nil(cl_object o) {
	return cast(cl_fixnum)o == ECL_NIL;
}

string toDString(cl_object clstr) {
	string result;
	debug if(!ecl_stringp(clstr))
		writeln("hello WARNING: not a string!");

	// base or unicode string?
	if(nil(si_base_string_p(clstr))) {
//		auto str = si_coerce_to_extended_string(clstr);
		debug displayExtStrInfo(clstr);
		dstring a = "";
		for(int i=0; i < clstr.ustring.fillp; ++i) a ~= ecl_char( clstr, i);
		result = toUTF8(a);
	} else {
		auto str = ecl_base_string_pointer_safe(clstr);
		auto l = strlen(str);
//		debug writeln("Length of parameter string is=", l);
		result = to!string(str);
	}

	return result;
}

cl_object toECLString(string str) {
	return si_string_to_object(1,
							   ecl_make_simple_base_string(cast(ubyte *)toStringz(str), str.length));
}

cl_object toECLString(dstring str) {
	debug writeln("toECLString got str=", str, ", ", str.length);
	debug scope(exit) writeln("toECLString end");

//    auto r = ecl_alloc_simple_vector(str.length, cl_elttype.ecl_aet_ch);
	auto r = ecl_alloc_adjustable_extended_string(str.length);
	int i;
	for(i = 0; i<str.length; ++i) {
		ecl_char_set( r, i, str[i]);
		debug write(".");
	}
	r.ustring.fillp = str.length;
	debug writeln(i);

	return r;
}

cl_object eval(T)(T str) {
	return cl_eval(toECLString(str));
}
